home *** CD-ROM | disk | FTP | other *** search
/ Input 64 / Input_64_86-05_1986_Verlag_Heinz_Weise_de.d64 / sets .lsp < prev    next >
Text File  |  2023-02-26  |  2KB  |  55 lines
  1. (setfns value (setfns mem1 subset 
  2. symm-diff union intersection makeset 
  3. seteq setp subsetp enter attach 
  4. insert dremove))
  5. (mem1 expr (lambda (l1 l2) (cond ((
  6. atom l1) nil) ((member (car l1) l2)) (
  7. t (mem1 (cdr l1) l2)))))
  8. (subset expr (lambda (fun l) (cond ((
  9. atom l) nil) ((apply* fun (car l)) (
  10. cons (car l) (subset fun (cdr l)))) (
  11. t (subset fun (cdr l))))))
  12. (symm-diff expr (lambda (l1 l2) (cond 
  13. ((atom l1) nil) ((member (car l1) l2) 
  14. (symm-diff (cdr l1) l2)) (t (cons (
  15. car l1) (symm-diff (cdr l1) l2))))))
  16. (union expr (lambda (l1 l2) (cond ((
  17. atom l1) l2) ((member (car l1) l2) (
  18. union (cdr l1) l2)) (t (cons (car l1) 
  19. (union (cdr l1) l2))))))
  20. (intersection expr (lambda (l1 l2) (
  21. cond ((atom l1) nil) ((member (car l1)
  22.  l2) (cons (car l1) (intersection (
  23. cdr l1) l2))) (t (intersection (cdr 
  24. l1) l2)))))
  25. (makeset expr (lambda (l1) (cond ((
  26. atom l1) nil) ((not (member (car l1) (
  27. cdr l1))) (cons (car l1) (makeset (
  28. cdr l1)))) (t (makeset (cdr l1))))))
  29. (seteq expr (lambda (l1 l2) (cond ((
  30. equal l1 l2)) ((atom l1) (atom l2)) ((
  31. member (car l1) l2) (seteq (cdr l1) (
  32. remove (car l1) l2))))))
  33. (setp expr (lambda (l1) (cond ((null 
  34. l1) t) ((member (car l1) (cdr l1)) 
  35. nil) (t (setp (cdr l1))))))
  36. (subsetp expr (lambda (l1 l2) (cond ((
  37. equal l1 l2)) ((atom l1)) ((member (
  38. car l1) l2) (subsetp (cdr l1) l2)))))
  39. (enter expr (lambda (x l) (cond ((
  40. member x l) l) (t (attach x l)))))
  41. (attach expr (lambda (x l) (cond ((
  42. atom l) (cons x nil)) (t (rplacd l (
  43. cons (car l) (cdr l))) (rplaca l x))))
  44. )
  45. (insert expr (lambda (x y l) (attach 
  46. x (nth l y)) l))
  47. (dremove expr (lambda (l1 l2) (prog (
  48. l3 l4) (setq l4 l2) loop (cond ((atom 
  49. l4) (return l2)) ((setq l3 (member l1 
  50. l4)) (cond ((atom (cdr l3)) (return 
  51. l2)) (t (rplaca l3 (cadr l3)) (rplacd 
  52. l3 (cddr l3))))) (t (setq l4 (cdr l4))
  53. )) (go loop))))
  54. nil
  55.